home *** CD-ROM | disk | FTP | other *** search
/ Merciful 1 / Merciful - Disc 1.iso / software / t / touch_stones / touchstones.dms / touchstones.adf / Empty / ProgStones1.Bak / ProgStones1.amosSourceCode < prev    next >
AMOS Source Code  |  1987-02-25  |  3KB  |  180 lines
  1. Screen Open 0,352,290,32,0
  2. Screen Display 0,112,18,352,290
  3. Flash Off 
  4. '
  5. Dim N(12,8)
  6. '
  7. '
  8. Load "Spencer:Empty/Stones.abk"
  9. '
  10. Load Iff "Spencer:Lo-Res/TouchstonesBoard1"
  11. '  
  12. '
  13. '
  14. '
  15. Randomize Timer
  16. Dim ARRAYA(12,8),ARRAYB(72)
  17. For A=1 To 36
  18.    ARRAYB(A)=A
  19.    ARRAYB(36+A)=A
  20. Next A
  21. For A=1 To 300
  22.    B=Rnd(71)+1
  23.    ABACK: C=Rnd(71)+1 : If C=B Then Goto ABACK
  24.    D=ARRAYB(B)
  25.    ARRAYB(B)=ARRAYB(C)
  26.    ARRAYB(C)=D
  27. Next A
  28. '
  29. 'Setting Up Board
  30. ARRAYA(1,1)=ARRAYB(1) : Paste Bob 1*20+20,1*20+18,ARRAYB(B)
  31. ARRAYA(12,1)=ARRAYB(2) : Paste Bob 12*20+20,38,ARRAYB(2)
  32. ARRAYA(1,8)=ARRAYB(3) : Paste Bob 40,178,ARRAYB(3)
  33. ARRAYA(12,8)=ARRAYB(4) : Paste Bob 260,178,ARRAYB(4)
  34. ARRAYA(6,4)=ARRAYB(5) : Paste Bob 140,98,ARRAYB(5)
  35. ARRAYA(7,5)=ARRAYB(6) : Paste Bob 160,118,ARRAYB(6)
  36. '
  37. LSCORE=0 : RSCORE=0
  38. PSCORE
  39. '
  40. '
  41. '
  42. '
  43. COUNT=7
  44. Gosub PNEXTSTONES
  45. NEK: K=Mouse Key : If K=1 Then Goto CHECKSQ Else Goto NEK
  46. CHECKSQ: X=X Mouse : Y=Y Mouse
  47. XP=Int((X-132)/20) : YP=Int((Y-36)/20)
  48. '
  49. L=XP : M=YP : Gosub SCORER
  50. If TEMPSCORE=0 Then Goto NEK
  51. If ARRAYA(L,M)>0 Then Goto NEK
  52. '
  53. XPX=XP*20+132 : YPY=YP*20+36
  54. Amreg(0)=(XPX-412) : Amreg(1)=(YPY-56)
  55. Sprite 4,412,56,ARRAYB(COUNT)
  56. A$="M RA,RB,50"
  57. Amal 4,A$
  58. Amal On 4
  59. Wait 50 : Sprite Off 4
  60. Paste Bob XP*20+20,YP*20+18,ARRAYB(COUNT)
  61. Amal Off 0
  62. L=XP : M=YP
  63. Gosub SCORER
  64. LSCORE=LSCORE+TEMPSCORE
  65. If COUNT=72 Then Direct 
  66. ARRAYA(L,M)=ARRAYB(COUNT)
  67. PSCORE
  68. Inc COUNT
  69. Gosub PNEXTSTONES
  70. Goto NEK
  71. '
  72. '
  73. '
  74. Hide On 
  75. Double Buffer 
  76. Limit Mouse 112,18 To 462,300
  77. '
  78. '
  79. LMAN
  80. Wait Key 
  81. Direct 
  82. '
  83. '
  84. '
  85. Procedure LMAN
  86.    Bob 3,X Mouse,Y Mouse,37
  87.    C$="A 0,(37,2)(38,3)(39,4)(40,5)(41,6)(40,5)(39,4)(38,3) ; "
  88.    C$=C$+"Loop: L X=XM-112 L Y=YM-18 Pause J Loop"
  89.    Channel 3 To Bob 3
  90.    Amal 3,C$
  91.    Amal On 
  92. End Proc
  93. '
  94. '
  95. Procedure PSCORE
  96.    Shared LSCORE,RSCORE
  97.    PS1=Int(LSCORE/100) : PSS=PS1*100 : PS2=Int((LSCORE-PSS)/10)
  98.    PST=PS2*10 : PS3=LSCORE-PSS-PST
  99.    Paste Bob 40,218,47+PS1
  100.    Paste Bob 60,218,47+PS2
  101.    Paste Bob 80,218,47+PS3
  102.    PS1=Int(RSCORE/100) : PSS=PS1*100 : PS2=Int((RSCORE-PSS)/10)
  103.    PST=PS2*10 : PS3=RSCORE-PSS-PST
  104.    Paste Bob 219,218,47+PS1
  105.    Paste Bob 239,218,47+PS2
  106.    Paste Bob 259,218,47+PS3
  107. End Proc
  108. '
  109. '
  110. PNEXTSTONES:
  111. LLL=0 : SCORENO=0
  112. LBL5: For L=1 To 12
  113.    For M=1 To 8
  114.       N(L,M)=0
  115.       If ARRAYA(L,M)=0
  116.          Gosub SCORER
  117.          SCORENO=SCORENO+TEMPSCORE
  118. N(L,M)=TEMPSCORE
  119. RSCORE=LLL
  120. PSCORE
  121.       End If 
  122.    Next M
  123. Next L
  124. If LLL=73 Then Direct 
  125. If SCORENO>0 Then Goto SHUF
  126. Gosub SHUFFLE
  127. LLL=LLL+1
  128. Goto LBL5
  129. SHUF:
  130. For A=COUNT To COUNT+7
  131.    If A>72 Then Goto BBACK
  132.    Paste Bob 300,(A-COUNT)*20+38,ARRAYB(A)
  133.    Goto CBACK
  134.    BBACK: Paste Bob 299,(A-COUNT)*20+38,47
  135. CBACK: Next A
  136. Return 
  137. '
  138. '
  139. '
  140. SCORER: TEMPSCORE=0
  141. J=ARRAYB(COUNT)
  142. If M=1 Then Goto LBL1
  143. K=ARRAYA(L,M-1)
  144. Gosub SCOREMATCH
  145. '
  146. LBL1: If M=8 Then Goto LBL2
  147. K=ARRAYA(L,M+1)
  148. Gosub SCOREMATCH
  149. '
  150. LBL2: If L=1 Then Goto LBL3
  151. K=ARRAYA(L-1,M)
  152. Gosub SCOREMATCH
  153. '
  154. LBL3: If L=12 Then Goto LBL4
  155. K=ARRAYA(L+1,M)
  156. Gosub SCOREMATCH
  157. '
  158. LBL4: If TEMPSCORE=0 Then Return 
  159. TEMPSCORE=2^TEMPSCORE
  160. '
  161. Return 
  162. '
  163. '
  164. SCOREMATCH: If K=0 Then Return 
  165. Dec J : Dec K
  166. If Int(J/6)=Int(K/6) Then Inc TEMPSCORE
  167. If J-Int(J/6)=K-Int(K/6) Then Bell 
  168. If J=K Then Dec TEMPSCORE
  169. Return 
  170. '
  171. '
  172. '
  173. SHUFFLE:
  174. GG=ARRAYB(COUNT)
  175. For HH=COUNT To 71
  176.    ARRAYB(HH)=ARRAYB(HH+1)
  177. Next HH
  178. ARRAYB(72)=GG
  179. Inc LLL
  180. Return